home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 Christmas / macformat-045.iso / Shareware Plus / Utilities / Alpha ƒ / Tcl / Menus / ftpMenu.tcl < prev    next >
Encoding:
Text File  |  1996-08-18  |  7.8 KB  |  327 lines  |  [TEXT/ALFA]
  1.  
  2. if $startingUp {
  3.     set ftpMenu            "•141"
  4.     addMenu ftpMenu
  5.     return
  6. }
  7.  
  8.  
  9.  
  10. proc ftpMenu {} {}
  11.  
  12.  
  13. if {![info exists savePostHooks] || ![string match {*ftpPostHook*} $savePostHooks]} {
  14.     lappend savePostHooks ftpPostHook
  15. }
  16.  
  17.  
  18. proc ftpPostHook {name} {
  19.     global fetched
  20.     if {[info exists fetched($name)]} {
  21.         message "Updating '[file tail $name]'…"
  22.         set specs $fetched($name)
  23.         if {[string length [cadr $specs]]} {
  24.             ftpStore $name [car $specs] "[cadr $specs]/[file tail $name]" [caddr $specs] [cadddr $specs]
  25.         } else {
  26.             ftpStore $name [car $specs] "[file tail $name]" [caddr $specs] [cadddr $specs]
  27.         }
  28.     }
  29. }
  30.  
  31.  
  32. #         createFileSet
  33. proc rebuildFtpMenu {} {
  34.     global savedMounts ftpMenu
  35.     
  36.     menu -n $ftpMenu -p ftpMenuProc {
  37.         help
  38.         palette
  39.         "(-"
  40.         "<S/ibrowse…"
  41.         "<S/i<IbrowseCurrent…"
  42.         addMountPoint…
  43.         removeMountPoint…
  44.         flushCache
  45.         "(-"
  46.         "createFileset"
  47.         setDefaults
  48.         "(-"
  49.     }
  50.     if {[info exists savedMounts]} {
  51.         foreach m [lsort -ignore [array names savedMounts]] {
  52.             addMenuItem -m -l "b " $ftpMenu $m
  53.         }
  54.     }
  55. }
  56.  
  57. rebuildFtpMenu
  58.  
  59. insertMenu $ftpMenu
  60.  
  61. proc ftpMenuProc {menu item} {
  62.     global modifiedArrVars savedMounts PREFS fetched HOME ftpMenu
  63.     switch $item {
  64.         help                {editMark "$HOME:Help:Manual" "Ftp Browser" -r}
  65.         palette                {float -m $ftpMenu -n FTP -M -1}
  66.         browse                {eval ftpBrowse [lrange [getLogin {Browse remote machine:} 0] 0 3]}
  67.         browseCurrent        { if {[info exists fetched([car [winNames -f]])]} {
  68.                                 eval ftpBrowse $fetched([car [winNames -f]]) 
  69.                             } else {
  70.                                 beep; message "'[car [winNames]]' not from remote host."
  71.                             }}
  72.         addMountPoint        { addMountPoint }
  73.         createFileset        { ftpCreateFileset }
  74.         removeMountPoint    {
  75.             set pt [listpick -p "Remove which mount point?" [lsort -ignore [array names savedMounts]]]
  76.             unset savedMounts($pt)
  77.             removeArrDef savedMounts $pt
  78.             rebuildFtpMenu
  79.         }
  80.         setDefaults            { 
  81.             global ftpDefaults modifiedVars
  82.             set ftpDefaults [lrange [getLogin "Enter defaults that you wish saved:" 0] 0 3]
  83.             lappend modifiedVars ftpDefaults
  84.         }
  85.         flushCache        { rm "$PREFS:ftptmp:*" }
  86.         default {
  87.             eval ftpBrowse $savedMounts($item)
  88.         }
  89.     }
  90. }
  91.  
  92.  
  93. proc ftpFilesetOpen {menu item} {
  94.     global gfileSets PREFS fetched fileSetsExtra
  95.     
  96.     if {[set ind [lsearch $gfileSets($menu) "*$item"]] >= 0} {
  97.         set f [lindex $gfileSets($menu) $ind]
  98.         set lnm [file tail $f]
  99.         regsub -all {:} $f {/} f
  100.         set nm "$PREFS:ftptmp:$lnm"
  101.         set specs $fileSetsExtra($menu)
  102.         if {![file exists $nm]} {
  103.             ftpFetch $nm [car $specs] $f [caddr $specs] [cadddr $specs]
  104.         }
  105.         edit $nm
  106.         set fetched($nm) $specs
  107.     }
  108. }
  109.  
  110.  
  111. proc ftpCreateFileset {} {
  112.     global gfileSets gfileSetsType PREFS fileSetsExtra
  113.     
  114.     set specs [getLogin]
  115.     set name [car $specs]
  116.     set host [cadr $specs]
  117.     set path [caddr $specs]
  118.     set user [cadddr $specs]
  119.     set password [caddddr $specs]
  120.     set pattern "^[prompt {Name pattern?} {.*.[ch]}]$"
  121.     set path [string trimright $path {/}]
  122.  
  123.     set fileSetsExtra($name) [list $host $path $user $password]
  124.     
  125.     if { ![file exists "$PREFS:ftptmp:"] } {
  126.         mkdir "$PREFS:ftptmp:"
  127.     }
  128.     set nm "$PREFS:ftptmp:listing.$path"
  129.     ftpList $nm $host $path $user $password
  130.     set files {}
  131.     foreach f [processListing $nm] {
  132.         if {![string match {*/} $f] && [regexp $pattern $f]} {
  133.             lappend files "$path/$f"
  134.         }
  135.     }
  136.     regsub -all {/} $files {:} files
  137.  
  138.     global gfileSets gfileSetsType
  139.     set gfileSets($name) [lsort -command sortByTail $files]
  140.     set gfileSetsType($name) ftp
  141.     if {[askyesno "Save project fileset?"] == "yes"} {
  142.         addArrDef gfileSetsType $name ftp
  143.         addArrDef gfileSets $name  $gfileSets($name)
  144.         addArrDef fileSetsExtra $name $fileSetsExtra($name)
  145.     }
  146.     return $name
  147. }
  148.  
  149.  
  150. proc getLogin {{prompt {All but 'password' are required:}} {nm 1}} {
  151.     global ftpDefaults
  152.     if {[info exists ftpDefaults]} {
  153.         set defs $ftpDefaults
  154.     } else {
  155.         set defs {"" "" "" ""}
  156.     }
  157.     set left 10
  158.     set right 100
  159.     set top 10
  160.     set bottom 30
  161.     set eleft [expr $left + 100]
  162.     set eright 370
  163.     set incr 30
  164.  
  165.     set height 198
  166.     
  167.     if $nm {incr height $incr}
  168.     set l "dialog -w 400 -h $height -t [list $prompt] $left $top 400 $bottom"
  169.     
  170.     if {$nm} {
  171.         incr top $incr
  172.         incr bottom $incr
  173.         lappend l -t {Name:} $left $top $right $bottom
  174.         lappend l -e {} $eleft $top $eright $bottom
  175.     }
  176.     
  177.     incr top $incr
  178.     incr bottom $incr
  179.     lappend l -t {Host:} $left $top $right $bottom
  180.     lappend l -e [car $defs] $eleft $top $eright $bottom
  181.     
  182.     incr top $incr
  183.     incr bottom $incr
  184.     lappend l -t {Path:} $left $top $right $bottom
  185.     lappend l -e [cadr $defs] $eleft $top $eright $bottom
  186.     
  187.     incr top $incr
  188.     incr bottom $incr
  189.     lappend l -t {UserID:} $left $top $right $bottom
  190.     lappend l -e [caddr $defs] $eleft $top $eright $bottom
  191.     
  192.     incr top $incr
  193.     incr bottom $incr
  194.     lappend l -t {Password:} $left $top $right $bottom
  195.     lappend l -e [cadddr $defs] $eleft $top $eright $bottom
  196.     
  197.     incr top [expr $incr + 10]
  198.     incr bottom [expr $incr + 10]
  199.     lappend l -b "OK" $left $top $right [expr $top + 20]
  200.     lappend l -b "Cancel" [expr $left + 200] $top [expr $right + 200] [expr $top + 20]
  201.     
  202.     set res [eval "$l"]
  203.     if {[lindex $res end]} {error "Cancel"}
  204.     return $res
  205. }
  206.  
  207.  
  208. proc addMountPoint {} {
  209.     global savedMounts modifiedArrVars
  210.     
  211.     set res [getLogin]
  212.     if {[lindex $res 5]} {
  213.         set savedMounts([car $res]) [lrange $res 1 4]
  214.         lappend modifiedArrVars savedMounts
  215.         rebuildFtpMenu
  216.     }
  217. }
  218.  
  219.  
  220. proc ftpFetch {localName host path user password} {
  221.     global ftpSig
  222.     watchCursor
  223.     launchBackApplSigs [list Arch] ftpSig
  224.     set fd [open $localName "w"]
  225.     close $fd
  226.     AEBuild -r -t 30000 'Arch' Arch Ftch FTPh "“$host”" FTPc "“$path”" ArGU "“$user”" ArGp "“$password”" ---- [makeAlis $localName]
  227. }
  228.  
  229. proc ftpStore {localName host path user password} {
  230.     watchCursor
  231.     AEBuild -q -t 30000 'Arch' Arch Stor ---- [makeAlis $localName] FTPh "“$host”" FTPc "“$path”" ArGU "“$user”" ArGp "“$password”"
  232. }
  233.  
  234. proc handleReply {rep} {
  235.     global ALPHA lastReply
  236.     message "Remote save finished."
  237.     set lastReply $rep
  238. }
  239.  
  240. # 'localName' must be a preexisting file, this is a makeAlis limitation
  241. proc ftpList {localName host path user password} {
  242.     global ftpSig
  243.     watchCursor
  244.     launchBackApplSigs [list Arch] ftpSig
  245.     set fd [open $localName "w"]
  246.     close $fd
  247.     AEBuild -r -t 30000 '$ftpSig' Arch List FTPh "“$host”" FTPc "“$path”" ArGU "“$user”" ArGp "“$password”" {----} [makeAlis $localName]
  248. }
  249.  
  250.  
  251. proc processListing {path} {
  252.     set fd [open $path "r"]
  253.     set lines [split [read $fd] "\n"]
  254.     close $fd
  255.     set files {}
  256.     foreach f [cdr [lreplace $lines end end]] {
  257.         set nm [lindex $f end]
  258.         if {[string length $nm]} {
  259.             if {[string match "d*" $f]} {
  260.                 lappend files "$nm/"
  261.             } else {
  262.                 lappend files $nm
  263.             }
  264.         }
  265.     }
  266.     return $files
  267. }
  268.  
  269.  
  270. proc ftpBrowse {host dir user password} {
  271.     global PREFS fetched lastFtpDir
  272.  
  273.     watchCursor
  274.     if {![string length $password]} {
  275.         set password [prompt "Password:" ""]
  276.     }
  277.  
  278.     if {![file exists "$PREFS:ftptmp"]} {
  279.         mkdir "$PREFS:ftptmp"
  280.     }
  281.     if {$dir == {-}} {
  282.         if {![info exists lastFtpDir] || ![string length $lastFtpDir]} {set lastFtpDir ""}
  283.         set dir [prompt "'$host' dir:" $lastFtpDir]
  284.     }
  285.     set dir [string trimright $dir {/}]
  286.     set lastFtpDir $dir
  287.  
  288.     set num 0
  289.     for {set i [expr [string length $dir] - 1]} {$i >= 0} {incr i -1} {
  290.         scan $dir "%c" char
  291.         incr num $char
  292.     }
  293.     
  294.     set nm "$PREFS:ftptmp:listing.$num"
  295.     
  296.     if {![file exists $nm]} {
  297.         ftpList $nm $host $dir $user $password
  298.     }
  299.     set files [concat {..} [processListing $nm]]
  300.     set file [listpick -p "$dir/" $files]
  301.     if {$file == {..}} {
  302.         if {[regexp {((/|\w)+)/\w+} $dir dummy sub]} {
  303.             return [ftpBrowse $host $sub $user $password]
  304.         } else {
  305.             return [ftpBrowse $host "" $user $password]
  306.         }
  307.     }
  308.     if {[string match {*/} $file]} {
  309.         if {[string length $dir]} {
  310.             return [ftpBrowse $host [string trimright "$dir/$file" {/}] $user $password]
  311.         } else {
  312.             return [ftpBrowse $host [string trimright "$file" {/}] $user $password]
  313.         }
  314.     }
  315.  
  316.     set nm "$PREFS:ftptmp:$file"
  317.     if {![file exists $nm]} {
  318.         if {[string length $dir]} {
  319.             ftpFetch $nm $host "$dir/$file" $user $password
  320.         } else {
  321.             ftpFetch $nm $host "$file" $user $password
  322.         }
  323.     }
  324.     edit $nm
  325.     set fetched($nm) [list $host $dir $user $password]
  326. }
  327.